perm filename RECORD[RLL,DBL] blob
sn#652291 filedate 1982-04-07 generic text, type T, neo UTF8
(FILECREATED "26-Mar-82 13:04:57" <MANCOM.RLL>RECORDKBCHANGE..12 22829
changes to: RecordKBChange
previous date: "25-Mar-82 17:12:23" <MANCOM.RLL>RECORDKBCHANGE..11)
(PRETTYCOMPRINT RECORDKBCHANGECOMS)
(RPAQQ RECORDKBCHANGECOMS [(FNS * RECORDKBCHANGEFNS)
(VARS * RECORDKBCHANGEVARS)
(ALISTS * RECORDKBCHANGEALISTS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA /*)
(NLAML)
(LAMA /UA-TRANSFER /UA-REPLACEVALUE /UA-RENAME /UA-REMPROP
/UA-PUTPROP /UA-PUT /UA-DELVALUE /UA-DEL /UA-ADDVALUE
/UA-ADD /SubstValue /SubstField /PutValue /PutField
/NewKB /NU1 /KillValue /KillField /GetValue /GetField
/FNewUnit /EVAL /DeleteField /CreateUnit /AddValue
/AddField])
(RPAQQ RECORDKBCHANGEFNS (/* /AddField /AddValue /CreateUnit /DeleteField /EVAL /FNewUnit
/GetField /GetValue /KillField /KillValue /NU1 /NewKB
/PutField /PutValue /SubstField /SubstValue /UA-ADD
/UA-ADDVALUE /UA-DEL /UA-DELVALUE /UA-PUT /UA-PUTPROP
/UA-REMPROP /UA-RENAME /UA-REPLACEVALUE /UA-TRANSFER
ConfirmSlot CreateSlot KBChange LoadChanges MakeKB/Fn NU NU1
NewKB NewSubUnit NewUnit RecordKBChange VerifySlots))
(DEFINEQ
(/*
[NLAMBDA args
(* edited: " 1-Mar-82 15:05")
(RecordKBChange (CONS (QUOTE *)
args)
(APPLY (FUNCTION *)
args])
(/AddField
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE AddField)
(QUOTE args)
1 NIL])
(/AddValue
[LAMBDA args
(* edited: "25-Mar-82 15:40")
(DECLARE (SPECVARS args))
(KBChange (QUOTE AddValue)
(QUOTE args)
1 NIL])
(/CreateUnit
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE CreateUnit)
(QUOTE args)
1 NIL])
(/DeleteField
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE DeleteField)
(QUOTE args)
1 NIL])
(/EVAL
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE EVAL)
(QUOTE args)
NIL NIL])
(/FNewUnit
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE FNewUnit)
(QUOTE args)
1 NIL])
(/GetField
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE GetField)
(QUOTE args)
1 NIL])
(/GetValue
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE GetValue)
(QUOTE args)
1 NIL])
(/KillField
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE KillField)
(QUOTE args)
1 NIL])
(/KillValue
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE KillValue)
(QUOTE args)
1 NIL])
(/NU1
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE NU1)
(QUOTE args)
3 T])
(/NewKB
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE NewKB)
(QUOTE args)
1 T])
(/PutField
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE PutField)
(QUOTE args)
1 NIL])
(/PutValue
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE PutValue)
(QUOTE args)
1 NIL])
(/SubstField
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE SubstField)
(QUOTE args)
1 NIL])
(/SubstValue
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE SubstValue)
(QUOTE args)
1 NIL])
(/UA-ADD
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE UA-ADD)
(QUOTE args)
1 T])
(/UA-ADDVALUE
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE UA-ADDVALUE)
(QUOTE args)
1 NIL])
(/UA-DEL
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE UA-DEL)
(QUOTE args)
1 NIL])
(/UA-DELVALUE
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE UA-DELVALUE)
(QUOTE args)
1 NIL])
(/UA-PUT
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE UA-PUT)
(QUOTE args)
1 NIL])
(/UA-PUTPROP
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE UA-PUTPROP)
(QUOTE args)
1 NIL])
(/UA-REMPROP
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE UA-REMPROP)
(QUOTE args)
1 NIL])
(/UA-RENAME
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE UA-RENAME)
(QUOTE args)
1 NIL])
(/UA-REPLACEVALUE
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE UA-REPLACEVALUE)
(QUOTE args)
1 NIL])
(/UA-TRANSFER
[LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE UA-TRANSFER)
(QUOTE args)
1 NIL])
(ConfirmSlot
[LAMBDA (ThisUnit sl val ReturnVal)
(* edited: " 3-Mar-82 20:11")
(DECLARE (LOCALVARS ThisUnit sl val ReturnVal))
(* This is something which should be done only after an EDITU;
and checks that the slot name is legitimate.)
[OR val (PROGN (WRITELNTTY "You gave a value of NIL for slot " sl ".")
(SETQ ReturnVal (QUOTE EDITME]
(SETQ ReturnVal (OR (GoodSlot? sl (UA-KB? ThisUnit))
ReturnVal))
(SELECTQ ReturnVal
[EDITME (COND
((INTTYYNB (CONCAT "Should I just remove this slot "
"(as opposed to re-editing "
ThisUnit ")? "))
(/UA-REMPROP ThisUnit sl)
(QUOTE IgnoreMe))
(T (QUOTE ReDoMe]
ReturnVal])
(CreateSlot
[LAMBDA (hld kb extra-pairs name)
(* edited: "24-Mar-82 18:57")
(* This will create a new slot whose HighLevelDefn is hld, with
extra-pairs thrown in for good measure)
(COND
(name)
[(SETQ name (UE-ASKNEWUNIT (CONCAT "What name should be given a slot whose "
(QUOTE HighLevelDefn)
" is " hld "? "]
(T (SETQ name (NewUnitName (QUOTE Slot)))
(WRITELNTTY "Will use the name " name ".")))
(/FNewUnit name (QUOTE (AnyComputableSlot))
(QUOTE IExamples)
kb T NIL (CONS (CONS (QUOTE HighLevelDefn)
hld)
extra-pairs))
name])
(KBChange
[LAMBDA (FnName VarForArgs Arg#ForKB ArgIsKB?)
(* edited: "25-Mar-82 15:56")
(PROG ((RecordingLevel (IPLUS RecordingLevel 1))
form)
(DECLARE (SPECVARS RecordingLevel))
[SETQ form (CONS FnName (RPTQ (EVAL VarForArgs)
(SETQ form (CONS (KWOTE (APPLY* (QUOTE ARG)
VarForArgs RPTN))
form]
(RETURN (RecordKBChange form (EVAL form)
(COND
(Arg#ForKB (COND
(ArgIsKB? (APPLY* (QUOTE ARG)
VarForArgs Arg#ForKB))
(T (UA-KB? (APPLY* (QUOTE ARG)
VarForArgs Arg#ForKB])
(LoadChanges
[LAMBDA (File AcceptableKBs)
(* edited: " 3-Mar-82 20:38")
(PROG ([KBNames (COND
[AcceptableKBs
(MAPCAR (MKLIST AcceptableKBs)
(FUNCTION (LAMBDA (kb)
(DECLARE (SPECVARS kb))
(PACKFILENAME (QUOTE DIRECTORY)
NIL
(QUOTE VERSION)
NIL
(QUOTE BODY)
(CAR (SOME UF.NETWORKS
(FUNCTION (LAMBDA (poss)
(STRPOS kb poss]
(T (MAPCAR UF.NETWORKS (FUNCTION (LAMBDA (kb)
(PACKFILENAME (QUOTE DIRECTORY)
NIL
(QUOTE VERSION)
NIL
(QUOTE BODY)
kb]
New)
(DECLARE (SPECVARS KBNames))
(MAPC (READFILE File)
(FUNCTION (LAMBDA (expr)
(COND
([AND (OR (NULL (CAR expr))
(FMEMB (CAR expr)
KBNames))
(NULL (EQUAL (PROG1 (SETQ New (EVAL (CADR expr)))
(WRITELNTTY New))
(CADDR expr]
(Warning "Result of " (CADR expr)
" should be "
(CADDR expr)
" but is " New))
((EQ (CAR expr)
(QUOTE *))
(Warning expr])
(MakeKB/Fn
[LAMBDA (FnName)
(* edited: "25-Mar-82 16:18")
(PROG (WhichArgForKB KBOrUnit WhichFile (NewFnName (PACK* (QUOTE /)
FnName)))
(printout T "Number for arg indicating relevant KB: ")
(SETQ WhichArgForKB (LISPXREAD))
(printout T "T for arg is KB name, NIL if Unit name: ")
(SETQ KBOrUnit (LISPXREAD))
(printout T "File for new function (NIL = RECORDKBCHANGE): ")
(SETQ WhichFile (OR (LISPXREAD)
(QUOTE RECORDKBCHANGE)))
[PUTD NewFnName `(LAMBDA args
(DECLARE (SPECVARS args))
(KBChange (QUOTE ,FnName)
(QUOTE args)
,WhichArgForKB ,KBOrUnit]
(ADDTOFILE NewFnName (QUOTE FNS)
WhichFile)
(ADDTOFILE `(LISPXFNS ,FnName)
(QUOTE ALISTS)
WhichFile)
(push LISPXFNS (CONS FnName NewFnName])
(NU
[LAMBDA (NewUnit BasedOnUnit whichKB)
(* edited: "25-Mar-82 13:05" (Create a new unit which is very similar
to an existing one. Inverses are updated. Syntactic slots are
re-initialized, others are simply copied. Also, this name is
substituted for the name of the old unit.))
(DECLARE (LOCALVARS NewUnit BasedOnUnit whichKB))
(PROG (hold)
(DECLARE (LOCALVARS hold))
Top (COND
[(NULL NewUnit)
(COND
((SETQ NewUnit (UE-ASKNEWUNIT "Name: "))
(GO Top))
(T (WRITELNTTY "Nothing done.")
(RETURN NIL]
((Unitp NewUnit)
(WRITELNTTY "Sorry, that unit name is already taken. ")
(SETQ NewUnit NIL)
(GO Top))
[(NULL BasedOnUnit)
(COND
((SETQ BasedOnUnit (UE-ASKUNIT "Copy from: "))
(GO Top))
(T (WRITELNTTY "Nothing done.")
(RETURN NIL]
((NOT (Unitp BasedOnUnit))
(WRITELNTTY "Sorry, must copy from an existing unit. ")
(SETQ BasedOnUnit NIL)
(GO Top))
(T
(* Now NewUnit and BasedOnUnit are legal names)
(/NU1 NewUnit BasedOnUnit (WhatKB NewUnit whichKB T (UA-KB? BasedOnUnit])
(NU1
[LAMBDA (NewUnit BasedOnUnit whichKB)
(* edited: "25-Mar-82 13:06" (Create a new unit which is very similar
to an existing one. Inverses are updated. Syntactic slots are
re-initialized, others are simply copied. Also, this name is
substituted for the name of the old unit.))
(DECLARE (LOCALVARS NewUnit BasedOnUnit whichKB))
(CreateUnit NewUnit whichKB)
(UA-SETPROPLIST NewUnit (DSUBST NewUnit BasedOnUnit (CopySemanticSlots BasedOnUnit)))
(InitializeSELFSlots NewUnit `((Parents ,BasedOnUnit)
(Inheritance . ICopiedFrom))
NIL)
[UA-PUTPROP NewUnit (QUOTE MySensibleSlots)
(GetValue NewUnit (QUOTE MySensibleSlots)
(QUOTE (SAFESLOT]
(APPLY* (FUNCTION EDITU)
NewUnit
(QUOTE (-USE-OLD-VALUE -VERIFY-SLOT)))
(* (This already done, thanks to MySensibleSlot : ToPutValue %.)
UA-REMPROP NewUnit (QUOTE MySensibleSlots))
NewUnit])
(NewKB
[LAMBDA (nam)
(* edited: "24-Mar-82 18:46" Name no longer optional, to make
recording easier...)
(DECLARE (LOCALVARS nam))
[AND (SETQ nam (U-CASE nam))
(UF-CREATE (PACK* nam (QUOTE .PAGE)))
(PROG ((nam.status (ENSTATUS nam)))
(DECLARE (LOCALVARS nam.status))
(FNewUnit nam.status (QUOTE (AnyStatus))
(QUOTE IExamples)
nam T NIL NIL)
(AddValue (ENSTATUS KernelKB)
(QUOTE DependentNetworks)
nam)
[SET (PACK* nam (QUOTE COMS))
`((FNS * , (PACK* nam (QUOTE FNS)))
(VARS * , (PACK* nam (QUOTE VARS]
(SET (PACK* nam (QUOTE FNS))
NIL)
(SET (PACK* nam (QUOTE VARS))
NIL)
(MAKEFILE nam)
(WRITELNTTY " Just to play it safe, I'll now close the neonatal " nam
" network, and then reopen it.
")
[RLL-WRITE nam (QUOTE ((N]
(RLL-OPEN nam (QUOTE (Y (N]
nam])
(NewSubUnit
[LAMBDA (Son uN sL whichKB)
(* edited: "24-Mar-82 19:27" Create a new unit which is an instance of
an existing one)
(DECLARE (LOCALVARS Son uN sL whichKB))
(PROG (pos)
(DECLARE (LOCALVARS pos))
Top (COND
[(NOT (Unitp uN))
(COND
((AND Son (SETQ pos (STRPOS (QUOTE Of)
Son 1 NIL NIL NIL))
(INTTYYNB (CONCAT "On unit named " (SETQ uN (SUBATOM Son 1
(SUB1 pos)))
"? ")))
(GO Top))
((SETQ uN (UE-ASKUNIT "On which unit: "))
(GO Top))
(T (WRITELNTTY "Nothing done")
(RETURN NIL]
[(NOT (Ancestor? sL AnyUnitFunction))
(COND
((AND Son (SETQ pos (STRPOS (QUOTE Of)
Son 1 NIL NIL NIL))
(INTTYYNB (CONCAT "For the slot " (SETQ sL (SUBATOM Son
(IPLUS 2 pos)
NIL))
"? ")))
(GO Top))
((SETQ sL (UE-ASKUNIT "For which slot: "))
(GO Top))
(T (WRITELNTTY "Nothing done")
(RETURN NIL]
[(NULL Son)
(COND
((INTTYYNB (CONCAT "Shall I create the unit " (SETQ Son (NewSubUnitName
uN sL))
"? "))
(GO Top))
((SETQ Son (UE-ASKNEWUNIT "Enter your proposed name: "))
(GO Top))
(T (WRITELNTTY "Nothing done.")
(RETURN NIL]
((Unitp Son)
(WRITELNTTY "That name, " Son ", is already in use.")
(SETQ Son NIL)
(GO Top)))
(/FNewUnit Son (LIST uN sL)
(QUOTE ISubUnit)
(WhatKB Son whichKB T (UA-KB? uN))
NIL
(LIST (LIST (QUOTE U&SLocation)
uN sL)
(CONS (QUOTE SlotValue)
(UA-GETPROP uN sL)))
NIL)
(WRITELNTTY " * Initialized " Son " *")
(APPLY* (FUNCTION EDITU)
Son
(QUOTE (-USE-OLD-VALUE -VERIFY-SLOT)))
(RETURN Son])
(NewUnit
[LAMBDA (NewUn ParentS inher whichKB uMode)
(* edited: "24-Mar-82 18:39" * Create a new unit which is an
Something-or-Other of an existing one)
(DECLARE (LOCALVARS NewUn ParentS inher whichKB uMode))
(PROG NIL
Top (COND
[(NULL NewUn)
(COND
((SETQ NewUn (UE-ASKNEWUNIT "Name: "))
(GO Top))
(T (WRITELNTTY "Nothing done.")
(RETURN NIL]
((Unitp NewUn)
(WRITELNTTY "Sorry, that unit name is already taken. ")
(SETQ NewUn NIL)
(GO Top))
((AND (NULL ParentS)
[SETQ ParentS (IsOk-Fn (UA-GETPROP inher (QUOTE SuggestedParents]
(SETQ ParentS (APPLY* ParentS NewUn)))
(WRITELNTTY "The units " ParentS " were proposed.")
(OR (INTTYYNB "Are they the desired parents? ")
(SETQ ParentS (QUOTE TriedOnce)))
(GO Top))
[(FMEMB ParentS (QUOTE (TriedOnce NIL)))
(COND
((SETQ ParentS (INTTY (CONCAT "Is a " inher " of: ")
NIL "Expecting a unit, or list of units." T))
(GO Top))
(T (WRITELNTTY "Nothing done.")
(RETURN NIL]
(T (OR (LISTP ParentS)
(SETQ ParentS (LIST ParentS)))
(OR (EVERY ParentS (FUNCTION Unitp))
(Warning "!!! You are pointing to a nonexistent unit !!!"))
(* Now NewUn (and ParentS) are legal names as is whichKB;
and hopefully, inher)
(/FNewUnit NewUn ParentS inher (WhatKB NewUn whichKB T
(UA-KB? (CAR ParentS)))
NIL NIL NIL)
[/UA-PUTPROP NewUn (QUOTE MySensibleSlots)
(GetValue NewUn (QUOTE MySensibleSlots)
(QUOTE (SAFESLOT]
(WRITELNTTY " * Initialized " NewUn " *")
(APPLY* (FUNCTION EDITU)
NewUn
(QUOTE (-USE-OLD-VALUE -VERIFY-SLOT)))
(RETURN NewUn])
(RecordKBChange
[LAMBDA (form result kb)
(* edited: "26-Mar-82 13:04")
(PROG ((PrintOffset (ITIMES (IDIFFERENCE RecordingLevel 1)
4))
t0)
[COND
((NOT (OPENP ChangesFileName (QUOTE OUTPUT)))
(SETQ ChangesFileName (OPENFILE (PACKFILENAME (QUOTE DIRECTORY)
NIL
(QUOTE EXTENSION)
(PDATE)
(QUOTE VERSION)
NIL
(QUOTE BODY)
ChangesFileName)
(QUOTE OUTPUT)))
(printout ChangesFileName "[* **** RLL KB Changes from " (DATE)
" by " USERNAME " **** ")
(printout TTY "Starting changes file " ChangesFileName T T
"Heading or note (input as list): ")
(COND
((SETQ t0 (LISPXREAD))
(printout ChangesFileName T T 6 .PARA NIL -15 t0 .SP 2 "]" T T))
(T (printout ChangesFileName "]" T T]
(COND
((EQ (CAR form)
(QUOTE *))
(printout ChangesFileName T form T T))
(T (printout ChangesFileName .SP PrintOffset "[ " (PACKFILENAME (QUOTE
DIRECTORY)
NIL
(QUOTE
VERSION)
NIL
(QUOTE BODY)
kb
(QUOTE NAME)
"NIL")
.TAB
(IPLUS PrintOffset 18)
.PPV form .SP 2 result .SP 2 RecordingLevel " ]" T T)))
(CLOSEF ChangesFileName)
(OPENFILE ChangesFileName (QUOTE APPEND)
(QUOTE OLD))
(RETURN result])
(VerifySlots
[LAMBDA (ThisUnit newprops oldprops also4put simpleput)
(* edited: " 3-Mar-82 20:10")
(DECLARE (LOCALVARS ThisUnit newprops oldprops also4put simpleput))
(* COPY is done so changes to this proplist done at one place do NOT
propagate.)
(PROG ([uAllProps (UNION (MAPCAR newprops (FUNCTION IDENTITY)
(FUNCTION CDDR))
(MAPCAR oldprops (FUNCTION IDENTITY)
(FUNCTION CDDR]
(cs NIL))
(DECLARE (SPECVARS uAllProps cs))
[COND
(simpleput (WRITELNTTY "Using UA-PUTPROP, not full PutValue"))
(T [SETQ uAllProps (MAPCAR uAllProps
(FUNCTION (LAMBDA (slt)
(CONS (GetAccessFn slt (QUOTE OrderForToInit)
(QUOTE (SAFESLOT SAFEUNIT
-CACHE))
110 NIL)
slt]
(SETQ uAllProps (SORT uAllProps T))
(SETQ uAllProps (MAPCAR uAllProps (FUNCTION CDR]
[SETQ uAllProps (SUBSETC uAllProps (FUNCTION (LAMBDA (slot oldval newval)
(DECLARE (LOCALVARS slot oldval newval))
(SETQ oldval (LISTGET oldprops slot))
(SETQ newval (LISTGET newprops slot))
(AND (OR also4put (NOT (EQUAL oldval newval)))
(LIST slot newval oldval]
(OR
[EVERY
uAllProps
(FUNCTION (LAMBDA (slno)
(DECLARE (LOCALVARS slno))
(PROG ((slot (CAR slno))
(realnew (CADR slno))
(realold (CADDR slno)))
(DECLARE (LOCALVARS slot realold)
(SPECVARS realnew cs uAllProps))
(RETURN
(COND
([AND (NOT simpleput)
[SETQ cs (IsOk (UA-GETPROP slot (QUOTE DerivedFrom]
(EVERY cs (FUNCTION (LAMBDA (ds)
(DECLARE (LOCALVARS ds)
(SPECVARS uAllProps))
(ASSOC ds uAllProps]
(* (This will be recomputed anyway:) UA-REMPROP ThisUnit slot)
T)
([AND realnew (NOT simpleput)
(EQ (QUOTE ReDoMe)
(SETQ cs (ConfirmSlot ThisUnit slot realnew]
NIL)
((EQ cs (QUOTE IgnoreMe))
T)
(T (AND (EQ (CAR cs)
(QUOTE NewSlot))
(SETQ slot (CDR cs)))
(* Here there was no former value. or it does NOT equal the new
value.)
(PROG (hold (PassValueToEDITU NIL))
(DECLARE (LOCALVARS hold)
(SPECVARS PassValueToEDITU))
DoPUT
(COND
([SETQ hold (COND
((NOT simpleput)
(/PutValue ThisUnit slot realnew realold
also4put))
(realnew (/UA-PUTPROP ThisUnit slot realnew))
(T (/UA-REMPROP ThisUnit slot]
(RETURN hold))
(T (WRITELNTTY "Trouble doing actual Put ("
ThisUnit " " slot " " realnew ")")
(SELECTQ [INTTY (CONCAT "Shall I go on, "
"break, "
"force this value in, "
"or do you want to edit this value? ")
(QUOTE ((G "o
")
(B "reak
")
(F "orce
")
(E "dit
"]
(B (Warning
"Trouble doing actual Put ("
ThisUnit " " slot " "
realnew ")"))
(F (COND
(realnew (/UA-PUTPROP ThisUnit
slot
realnew))
(T (/UA-REMPROP ThisUnit slot)))
(RETURN T))
(G (RETURN T))
(E (SETQ realnew (LIST slot realnew))
(WRITELNTTY "*** " "The value of "
ThisUnit ":" slot
" ***")
(EDITE realnew NIL ThisUnit NIL NIL)
(* Trouble: unable to pass PassValueToEDITU -
because of ADVISE ...)
(SETQ realnew (CADR realnew))
(AND (EQ PassValueToEDITU
(QUOTE SimplePutInEDITU))
(SETQ simpleput T))
(GO DoPUT))
(PROGN (WRITELNTTY "Going on")
(RETURN T]
(RETURN cs])
)
(RPAQQ RECORDKBCHANGEVARS ((ChangesFileName (QUOTE KB-CHANGES))
(RecordingLevel 0)))
(RPAQQ ChangesFileName KB-CHANGES)
(RPAQ RecordingLevel 0)
(RPAQQ RECORDKBCHANGEALISTS ((LISPXFNS AddField AddValue * CreateUnit DeleteField EVAL
FNewUnit GetField GetValue KillField KillValue NU1
NewKB PutField PutValue SubstField SubstValue
UA-ADD UA-ADDVALUE UA-DEL UA-DELVALUE UA-PUT
UA-PUTPROP UA-REMPROP UA-RENAME UA-REPLACEVALUE
UA-TRANSFER)))
(ADDTOVAR LISPXFNS (AddField . /AddField)
(AddValue . /AddValue)
(* . /*)
(CreateUnit . /CreateUnit)
(DeleteField . /DeleteField)
(EVAL . /EVAL)
(FNewUnit . /FNewUnit)
(GetField . /GetField)
(GetValue . /GetValue)
(KillField . /KillField)
(KillValue . /KillValue)
(NU1 . /NU1)
(NewKB . /NewKB)
(PutField . /PutField)
(PutValue . /PutValue)
(SubstField . /SubstField)
(SubstValue . /SubstValue)
(UA-ADD . /UA-ADD)
(UA-ADDVALUE . /UA-ADDVALUE)
(UA-DEL . /UA-DEL)
(UA-DELVALUE . /UA-DELVALUE)
(UA-PUT . /UA-PUT)
(UA-PUTPROP . /UA-PUTPROP)
(UA-REMPROP . /UA-REMPROP)
(UA-RENAME . /UA-RENAME)
(UA-REPLACEVALUE . /UA-REPLACEVALUE)
(UA-TRANSFER . /UA-TRANSFER))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA /*)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA /UA-TRANSFER /UA-REPLACEVALUE /UA-RENAME /UA-REMPROP /UA-PUTPROP /UA-PUT
/UA-DELVALUE /UA-DEL /UA-ADDVALUE /UA-ADD /SubstValue
/SubstField /PutValue /PutField /NewKB /NU1 /KillValue
/KillField /GetValue /GetField /FNewUnit /EVAL /DeleteField
/CreateUnit /AddValue /AddField)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1255 21032 (/* 1267 . 1424) (/AddField 1428 . 1554) (/AddValue 1558 . 1731)
(/CreateUnit 1735 . 1865) (/DeleteField 1869 . 2001) (/EVAL 2005 . 2125) (/FNewUnit 2129
. 2255) (/GetField 2259 . 2385) (/GetValue 2389 . 2515) (/KillField 2519 . 2647) (
/KillValue 2651 . 2779) (/NU1 2783 . 2897) (/NewKB 2901 . 3019) (/PutField 3023 . 3149) (
/PutValue 3153 . 3279) (/SubstField 3283 . 3413) (/SubstValue 3417 . 3547) (/UA-ADD 3551 .
3671) (/UA-ADDVALUE 3675 . 3807) (/UA-DEL 3811 . 3933) (/UA-DELVALUE 3937 . 4069) (
/UA-PUT 4073 . 4195) (/UA-PUTPROP 4199 . 4329) (/UA-REMPROP 4333 . 4463) (/UA-RENAME 4467
. 4595) (/UA-REPLACEVALUE 4599 . 4739) (/UA-TRANSFER 4743 . 4875) (ConfirmSlot 4879 . 5619
) (CreateSlot 5623 . 6281) (KBChange 6285 . 6894) (LoadChanges 6898 . 8007) (MakeKB/Fn
8011 . 8908) (NU 8912 . 10097) (NU1 10101 . 11052) (NewKB 11056 . 11999) (NewSubUnit 12003
. 13815) (NewUnit 13819 . 15623) (RecordKBChange 15627 . 17111) (VerifySlots 17115 .
21029)))))
STOP